(use-modules (srfi srfi-1)
              (ice-9 rdelim))

(load "lib/irregex.scm")
(load "lib/cgi-lib.scm")
(define env (read-parse))
(define *dispatch-table* '())
(define *headers* '())
(define *params* '())
(define *get-vars '())
(define *post-vars '())
(define *server-vars* '())
(define *cookies* '())
(define *output-buffer* '())

(define p display)

(define (get$ key)
  (find-var 'GET_VARS key))

(define (post$ key) 
   (find-var 'POST_VARS key))

(define (cookie$ key) 
  (find-var 'COOKIES key))

(define (find-var collection key)
   (let ((res (assoc key (env collection))))
    (cond ((eq? #f res) '())
          (else (cadr res)))))
(define (set-cookie key val . extra)
  (set! val
        (cond
         ((number? val) (number->string val))
         (else val)))
  (set! *cookies* (cons (list key val extra) *cookies*)))

(define (send-cookies)
  (map
   (lambda (c)
     (add-header/allowdup (string-concatenate (list "Set-Cookie: " (car c) "=" (cadr c) ";" (string-concatenate (caddr c)))))) *cookies*))
  
(define (error code)
  (cond
   ((equal? code "404")  "The resouce you requested is not found")))

;; thanks little schemer
(define (rember a lat)
  (cond
   ((null? lat) '())
   ((eq? (car lat) a) (cdr lat))
   (else (cons (car lat)
               (rember a (cdr lat))))))

(define (add-header header)
  (set! *headers* (cons header (rember header *headers*))))

(define (add-header/allowdup header)
  (set! *headers* (cons header  *headers*)))

(define (display-headers headers)
  (cond
   ((null? headers) (display "\n"))
   (else (begin
           (display (car headers))
           (newline)
           (display-headers (cdr headers))))))

(define (return-args uri pattern)
  (letrec
      ((get-arg-list (lambda (matches idx l)
                       (cond
                        ((eq? #f matches) '())
                        ((not (irregex-match-valid-index? matches idx)) l)
                        (else (get-arg-list matches (+ 1 idx) (cons (irregex-match-substring matches idx) l)))))))
    
    (get-arg-list (irregex-match  pattern uri) 1 '())))


(define (get req resp)
  (set! *dispatch-table* (cons (list "GET" (irregex-replace ":.+" req "(.+)") resp) *dispatch-table*)))

(define (post req resp)
  (set! *dispatch-table* (cons (list "POST" (irregex-replace ":.+" req "(.+)") resp) *dispatch-table*)))

(define (default var val)
  (cond
   ((not var) val)
   ((null? var) val)
   ((equal? "" var) val)
   (else var)))

(define (root url)
  (let ((parts (str-split url #\/)))
    (cond
     ((not (pair? parts)) "/") ;; If we dont get a pair, that means the url is "/"
     (else (car parts)))))


(define (dispatch method uri)
  (let ((handler
         (find
          (lambda (n)
            (and
             (equal? method (car n))
             (equal? (root uri) (root (cadr n)))
             (irregex-search (cadr n) uri))) *dispatch-table*)))
    
    (cond
     ((or (eq? #f handler) (null? handler)) (error "404"))
     (else (apply (caddr handler) (return-args uri (cadr handler)))))))

(define (run)
  ;; This is the default content type to send if no other is set

  (add-header "Content-type: text/html")
 
  (add-to-buffer (dispatch (default (env 'REQUEST_METHOD) "GET")  (default (env 'PATH_INFO) "/")))
  (send-cookies)
  (display-headers *headers*)
  (display-headers *output-buffer*))

(define (drain-output port)
  (let loop ((chars '())
             (next (read-char port)))
    (if (eof-object? next)
        ; Modified to not return last 'line' with newline
        (list->string (reverse! (cdr chars)))
        (loop (cons next chars)
              (read-char port)))))

(define (readlines filename)
  (call-with-input-file filename
    (lambda (p)
      (drain-output p))))
   

;; Template is done as a macro is the compiled template will have access to the environment from which it was called
;; an output-string port is used so if a users template uses something like display or newline, it will return and not
;; just go to stdout
(define-macro (template filename)
  `(with-output-to-string (lambda ()(current-output-port)(eval-string (compile-template (readlines ,filename))))))
  
(define (add-to-buffer n)
  (set! *output-buffer* (cons n *output-buffer*)))

(define (compile-template body)
  (set! body (irregex-replace/all "\\%>" body "(display \""))
  (set! body (irregex-replace/all "<\\%" body "\") "))
  (string-append "(display \"" body "\")"))



(define (false->nil n)
  (cond
   ((not n) '())
   (else n)))

(define (false->string n)
  (cond
   ((not n) "")
   (else n)))


